home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.07.lha / AmiCAD / ARexx / TirerTraits.AmiCAD < prev    next >
Text File  |  2000-11-12  |  6KB  |  232 lines
  1. /* Décalage et alignement des extrémités d'un ensemble de lignes */
  2. /* Version 1.00 13/01/99 */
  3. /* Version 1.01 06/02/99, Ajout UNLOCK */
  4. /* Version 1.02 16/03/99, modif macro LIGNE */
  5. /* Version 1.03 22/09/99, correction bug si annulation GETPOINT (ajout UNLOCK) */
  6. /* Version 1.04 14/04/00, adaptation version 2.05 */
  7. /* Version 1.05 12/11/00, localisation anglais/français */
  8. /* $VER: 1.05 (© R.Florac, 12/11/2000) */
  9. options results
  10.  
  11. signal on error
  12. signal on syntax
  13.  
  14. 'LANGUAGE'
  15. if result="français.language" then fr=1
  16. else fr=0
  17.  
  18. 'FIRSTSEL'
  19. if result=0 then do
  20.     if fr=1 then 'MESSAGE("Sélectionnez les"+CHR(10)+"lignes à modifier"+CHR(10)+"avant d''appeler ce script")'
  21.     else 'MESSAGE("Select the lines"+CHR(10)+"to edit"+CHR(10)+"before calling this script")'
  22.     exit
  23. end
  24.  
  25. 'DEF LIGNE(P)=P&0X07FFF'
  26. 'DEF COLONNE(P)=P>>15'
  27. if fr=1 then 'LOCK:SELECT("Extrémité à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
  28. else 'LOCK:SELECT("Extremity to move?"+CHR(10)+"Left"+CHR(10)+"Top"+CHR(10)+"Right"+CHR(10)+"Bottom")'
  29. d=result
  30. select
  31.     when d=1 then do
  32.     if fr=1 then 'GETPOINT("Cliquez sur la colonne de destination")'
  33.     else 'GETPOINT("Click on the destination colonn")'
  34.     p=result
  35.     if p<0 then do
  36.         'UNLOCK'
  37.         exit
  38.     end
  39.     'COLONNE('p')'; col=result
  40.     'SAVEALL:FIRSTSEL'; o=result
  41.     do while o>0
  42.         mode=mode_ligne(o)
  43.         if mode~=-1000 then do
  44.         o = retracer_gauche(o,col,mode)
  45.         end
  46.         else do
  47.         'NEXTSEL('o')'; o=result
  48.         end
  49.     end
  50.     end
  51.     when d=2 then do
  52.     if fr=1 then 'GETPOINT("Cliquez sur la ligne de destination")'
  53.     else 'GETPOINT("Click on the destination line")'
  54.     p=result
  55.     if p<0 then do
  56.         'UNLOCK'
  57.         exit
  58.     end
  59.     'LIGNE('p')'; ligne=result
  60.     'SAVEALL:FIRSTSEL'; o=result
  61.     do while o>0
  62.         mode=mode_ligne(o)
  63.         if mode~=-1000 then do
  64.         o = retracer_haut(o,ligne,mode)
  65.         end
  66.         else do
  67.         'NEXTSEL('o')'; o=result
  68.         end
  69.     end
  70.     end
  71.     when d=3 then do
  72.     if fr=1 then 'GETPOINT("Cliquez sur la colonne de destination")'
  73.     else 'GETPOINT("Click on the destination colonn")'
  74.     p=result
  75.     if p<0 then do
  76.         'UNLOCK'
  77.         exit
  78.     end
  79.     'COLONNE('p')'; col=result
  80.     'SAVEALL:FIRSTSEL'; o=result
  81.     do while o>0
  82.         mode=mode_ligne(o)
  83.         if mode~=-1000 then do
  84.         o = retracer_droite(o,col,mode)
  85.         end
  86.         else do
  87.         'NEXTSEL('o')'; o=result
  88.         end
  89.     end
  90.     end
  91.     when d=4 then do
  92.     if fr=1 then 'GETPOINT("Cliquez sur la ligne de destination")'
  93.     else 'GETPOINT("Click on the destination line")'
  94.     p=result
  95.     if p<0 then do
  96.         'UNLOCK'
  97.         exit
  98.     end
  99.     'LIGNE('p')'; ligne=result
  100.     'SAVEALL:FIRSTSEL'; o=result
  101.     do while o>0
  102.         mode=mode_ligne(o)
  103.         if mode~=-1000 then do
  104.         o = retracer_bas(o,ligne,mode)
  105.         end
  106.         else do
  107.         'NEXTSEL('o')'; o=result
  108.         end
  109.     end
  110.     end
  111.     otherwise nop
  112. end
  113. 'UNLOCK'
  114. exit
  115.  
  116. mode_ligne: procedure
  117.     parse arg o
  118.     mode=-1000
  119.     'TYPE('o')'
  120.     select
  121.     when result=2 then mode=1   /* fil */
  122.     when result=15 then mode=2  /* ligne double */
  123.     when result=9 then mode=3   /* bus */
  124.     when result=8 then mode=0   /* pointillés */
  125.     when result=21 then do        /* ligne spéciale */
  126.         'PENWIDTH('o',-10000)'
  127.         mode=0-result
  128.     end
  129.     otherwise nop
  130.     end
  131.     return mode
  132.  
  133. minima: procedure
  134.     parse arg v1,v2
  135.     if v1<v2 then return v1
  136.     return v2
  137. end
  138.  
  139. maxima: procedure
  140.     parse arg v1,v2
  141.     if v1>v2 then return v1
  142.     return v2
  143. end
  144.  
  145. retracer_gauche: procedure
  146.     parse arg o,col,mode
  147.     'COORDS('o')'
  148.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  149.     xg=minima(x0,x1)
  150.     if x0=x1 then x1=col
  151.     if xg=x0 then do
  152.     x2=x1; y2=y1;
  153.     end
  154.     else do
  155.     x2=x0; y2=y0; y0=y1
  156.     end
  157.     'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
  158.     if no=o then o=0
  159.     else do
  160.     'NEXTSEL('o-1')'; o=result
  161.     end
  162.     return o
  163.  
  164. retracer_haut: procedure
  165.     parse arg o,ligne,mode
  166.     'COORDS('o')'
  167.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  168.     yh=minima(y0,y1)
  169.     if y0=y1 then y1=ligne
  170.     if yh=y0 then do
  171.     y2=y1; x2=x1;
  172.     end
  173.     else do
  174.     y2=y0; x2=x0; x0=x1
  175.     end
  176.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  177.     if no=o then o=0
  178.     else do
  179.     'NEXTSEL('o-1')'; o=result
  180.     end
  181.     return o
  182.  
  183. retracer_droite: procedure
  184.     parse arg o,col,mode
  185.     'COORDS('o')'
  186.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  187.     xd=maxima(x0,x1)
  188.     if x0=x1 then x0=col
  189.     if xd=x1 then do
  190.     x2=x0; y2=y0; y0=y1
  191.     end
  192.     else do
  193.     x2=x1; y2=y1
  194.     end
  195.     'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
  196.     if no=o then o=0
  197.     else do
  198.     'NEXTSEL('o-1')'; o=result
  199.     end
  200.     return o
  201.  
  202. retracer_bas: procedure
  203.     parse arg o,ligne,mode
  204.     'COORDS('o')'
  205.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  206.     yb=maxima(y0,y1)
  207.     if y0=y1 then y1=ligne
  208.     if yb=y0 then do
  209.     y2=y1; x2=x1;
  210.     end
  211.     else do
  212.     y2=y0; x2=x0; x0=x1
  213.     end
  214.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  215.     if no=o then o=0
  216.     else do
  217.     'NEXTSEL('o-1')'; o=result
  218.     end
  219.     return o
  220.  
  221. /* Traitement des erreurs, interruption du programme */
  222. syntax:
  223. erreur=RC
  224. if fr=1 then 'MESSAGE("Script TirerTraits.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
  225. else 'MESSAGE("TirerTraits.AmiCAD script"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
  226. exit
  227.  
  228. error:
  229. if fr=1 then 'MESSAGE("Script TirerTraits.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'"):UNLOCK'
  230. else 'MESSAGE("TirerTraits.AmiCAD script"+CHR(10)+"Error in line 'SIGL'"):UNLOCK'
  231. exit
  232.